home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok20.lha / ComplexLib / txt / LongMathLibExt.mod < prev    next >
Text File  |  1993-08-15  |  4KB  |  184 lines
  1.  
  2. (*********************************************************************
  3.  
  4.     :Program.       LongMathLibExt.mod
  5.     :Author.        Gary Struhlik  
  6.     :Address.    -
  7.     :Phone.      -
  8.     :shortcut.      [gs]
  9.     :Version.       1.0   
  10.     :Date.          06.10.1988
  11.     :Copyright.  PD
  12.     :Language.      Modula-II
  13.     :Translator. M2Amiga
  14.     :Imports.     -
  15.     :UpDate.     -
  16.     :Contents.     Zusätzliche mathematische Funktionen
  17.     :Remark.     Für den Amiga Modula-2 Klub / Stuttgart
  18.     :Remark.     Am 01.01.1989 mit M2Amiga 3.2d neu kompiliert
  19.  
  20. **********************************************************************)
  21.  
  22. IMPLEMENTATION MODULE LongMathLibExt; (* für Datentyp LONGREAL *)
  23.  
  24. FROM MathLibLong IMPORT sin,cos,ln,exp,sqrt,arctan;
  25.  
  26. PROCEDURE round ( x : LONGREAL ) : LONGINT;
  27. BEGIN
  28.    IF    x >= 0.0 THEN RETURN TRUNC( x + 0.5 )
  29.    ELSE  RETURN TRUNC( x - 0.5 )
  30.    END (* IF *)
  31. END round;        
  32.  
  33. PROCEDURE sqr ( x : LONGREAL ) : LONGREAL;
  34. BEGIN
  35.    RETURN x*x
  36. END sqr;       
  37.  
  38. PROCEDURE tan ( x : LONGREAL ) : LONGREAL;
  39. BEGIN
  40.    RETURN sin(x)/cos(x)
  41. END tan;
  42.  
  43. PROCEDURE arcsin ( x : LONGREAL ) : LONGREAL;
  44. BEGIN
  45.    IF x=1.0 THEN RETURN pi/2.0
  46.     ELSIF x=-1.0 THEN RETURN -pi/2.0
  47.    ELSE
  48.     RETURN arctan(x/sqrt(1.0-x*x))
  49.    END
  50. END arcsin;
  51.  
  52. PROCEDURE arccos ( x : LONGREAL ) : LONGREAL;
  53. BEGIN
  54.    IF x=1.0 THEN RETURN 0.0
  55.     ELSIF x=-1.0 THEN RETURN pi
  56.    ELSE
  57.     RETURN pi/2.0-arcsin(x)
  58.    END
  59. END arccos;
  60.  
  61. PROCEDURE sinh ( x : LONGREAL ) : LONGREAL;
  62. BEGIN
  63.    RETURN 0.5*(exp(x)-exp(-x))
  64. END sinh;
  65.  
  66. PROCEDURE cosh ( x : LONGREAL ) : LONGREAL;
  67. BEGIN
  68.    RETURN 0.5*(exp(x)+exp(-x))
  69. END cosh;
  70.  
  71. PROCEDURE tanh ( x : LONGREAL ) : LONGREAL;
  72. BEGIN
  73.    RETURN sinh(x)/cosh(x)
  74. END tanh;
  75.  
  76. PROCEDURE log ( x : LONGREAL ) : LONGREAL;
  77. BEGIN
  78.    RETURN ln(x)/ln10
  79. END log;
  80.  
  81. PROCEDURE PwrOfTen ( x : LONGREAL ) : LONGREAL;
  82. BEGIN
  83.    RETURN exp(x*ln10)
  84. END PwrOfTen;
  85.  
  86. PROCEDURE lb ( x : LONGREAL ) : LONGREAL;
  87. BEGIN
  88.    RETURN ln(x)/ln2
  89. END lb;
  90.  
  91. PROCEDURE PwrOfTwo ( x : LONGREAL ) : LONGREAL;
  92. BEGIN
  93.    RETURN exp(x*ln2)
  94. END PwrOfTwo;
  95.  
  96. PROCEDURE arsinh ( x : LONGREAL ) : LONGREAL;
  97. BEGIN
  98.    RETURN ln( x + sqrt( x*x + 1.0))
  99. END arsinh;
  100.  
  101. PROCEDURE arcosh ( x : LONGREAL ) : LONGREAL;
  102. BEGIN
  103.    IF (x > 1.0) THEN RETURN ln( x + sqrt( x*x - 1.0))  (* für x # 1.0  *)
  104.     ELSIF x=1.0 THEN RETURN 0.0
  105.    END (* IF *)
  106. END arcosh;
  107.  
  108. PROCEDURE artanh ( x : LONGREAL ) : LONGREAL;
  109. BEGIN
  110.    RETURN 0.5*ln( (1.0+x)/(1.0-x) )  (* für x # 1.0   *)
  111. END artanh;
  112.  
  113. PROCEDURE power ( x,y : LONGREAL ) : LONGREAL; (* x^y *)
  114. VAR
  115.     wert,n : LONGREAL;
  116.         i      : INTEGER;
  117. BEGIN
  118.    IF (x = 0.0) AND (y = 0.0) THEN
  119.        RETURN 1.0E-308
  120.      ELSIF x = 0.0 THEN
  121.            RETURN 0.0
  122.        ELSIF y = 0.0 THEN
  123.              RETURN 1.0
  124.        ELSIF x > 0.0 THEN
  125.              IF ( y-LONGREAL(TRUNC(y)) <> 0.0 ) THEN
  126.                 RETURN exp(y*ln(x))
  127.              ELSE
  128.                 n:=1.0;
  129.                 FOR i:=1 TO ABS(TRUNC(y)) DO
  130.                    n:=n*x
  131.                 END; (* FOR *)
  132.                 IF y > 0.0 THEN
  133.                    RETURN n
  134.                 ELSE
  135.                    RETURN 1.0/n
  136.                 END (* IF y > 0.0 *)
  137.              END (* IF y-LONGREAL... *)
  138.            ELSE    
  139.          IF (y-LONGREAL(TRUNC(y)) <> 0.0) THEN
  140.                 RETURN 1.0E-308
  141.              ELSE
  142.                 n:=1.0;
  143.                 FOR i:=1 TO ABS(TRUNC(y)) DO
  144.                    n:=n*x
  145.                 END; (* FOR *)
  146.                 IF y > 0.0 THEN 
  147.                    RETURN n
  148.                 ELSE
  149.                    RETURN 1.0/n
  150.                 END
  151.          END
  152.    END
  153. END power;   
  154.                                          
  155. PROCEDURE fact ( x : LONGREAL ) : LONGREAL; (*  Fakultät  *)
  156. VAR
  157.     i : INTEGER;
  158.         fac : LONGREAL;
  159. BEGIN
  160.    fac:=1.0;
  161.    IF (x = 1.0) OR (x = 0.0) THEN
  162.       RETURN 1.0
  163.     ELSIF x < 0.0 THEN
  164.       RETURN 1.0E-308
  165.     ELSE
  166.       FOR i:=2 TO TRUNC(x) DO
  167.           fac:=fac+fac*( LONGREAL(i)-1.0 )   
  168.       END; (* FOR *)
  169.       RETURN fac
  170.    END
  171. END fact;
  172.  
  173. PROCEDURE sgn ( x : LONGREAL ) : LONGREAL;
  174.         (*   Vorzeichen -1.0, 0.0 oder +1.0  *)
  175. BEGIN
  176.    IF x = 0.0 THEN
  177.       RETURN 0.0
  178.    ELSE
  179.       RETURN x/ABS(x)
  180.    END (* IF *)
  181. END sgn;
  182.  
  183. END LongMathLibExt.
  184.